Carousel Volume 2 #1/carousel.iso/mactosh/john/hc_quick.hqx/Quick Compacter™ 1.0.2/stack.txt

Text File | 1989-11-15 | 8.7 KB | 283 lines

-- stack: in.2
-- format: 8 (HyperCard 1)
-- flags: 0x1000 (none)
-- protect password hash: 0
-- maximum user level: 5 (scripting)
-- window: Rect(x1=0, y1=0, x2=0, y2=0)
-- screen: Rect(x1=0, y1=0, x2=0, y2=0)
-- card dimensions: w=0 h=0
-- scroll: x=0 y=0
-- background count: 1
-- first background id: 2588
-- card count: 1
-- first card id: 2975
-- list block id: 2058
-- print block id: 0
-- font table block id: 0
-- style table block id: 0
-- free block count: 0
-- free size: 0 bytes
-- total size: 39616 bytes
-- stack block size: 9216 bytes
-- created by hypercard version: 0x01228000
-- compacted by hypercard version: 0x01228000
-- modified by hypercard version: 0x01228000
-- opened by hypercard version: 0x01228000
-- patterns[0]: 0x0000000000000000
-- patterns[1]: 0x8000000008000000
-- patterns[2]: 0x8800220088002200
-- patterns[3]: 0x8888222288882222
-- patterns[4]: 0x88AA22AA88AA22AA
-- patterns[5]: 0xCCAA33AACCAA33AA
-- patterns[6]: 0xEEAABBAAEEAABBAA
-- patterns[7]: 0xEEBBBBEEEEBBBBEE
-- patterns[8]: 0xFFBBFFEEFFBBFFEE
-- patterns[9]: 0xFFBBFFFFFFBBFFFF
-- patterns[10]: 0x8010022001084004
-- patterns[11]: 0xFFFFFFFFFFFFFFFF
-- patterns[12]: 0x8822882288228822
-- patterns[13]: 0x1122448811224488
-- patterns[14]: 0xC4800C6843023026
-- patterns[15]: 0xB130031BD8C00C8D
-- patterns[16]: 0xAA00AA00AA00AA00
-- patterns[17]: 0x8822552288225522
-- patterns[18]: 0x8855225588552255
-- patterns[19]: 0x77DD77DD77DD77DD
-- patterns[20]: 0x8000000000000000
-- patterns[21]: 0xAA55AA55AA55AA55
-- patterns[22]: 0x038448300C020101
-- patterns[23]: 0x8244394482010101
-- patterns[24]: 0x8814224188412214
-- patterns[25]: 0x8080413E080814E3
-- patterns[26]: 0x22048C7422179810
-- patterns[27]: 0xBE808808EB088880
-- patterns[28]: 0x25C8328964244C92
-- patterns[29]: 0xA29C41BE2AC914EB
-- patterns[30]: 0x40A00000040A0000
-- patterns[31]: 0x8040200002040800
-- patterns[32]: 0xAA00800088008000
-- patterns[33]: 0xFF80808080808080
-- patterns[34]: 0x081C22C180010204
-- patterns[35]: 0xFF808080FF080808
-- patterns[36]: 0xF87422478F172271
-- patterns[37]: 0xBF00BFBFB0B0B0B0
-- patterns[38]: 0xFF7FBE5DA2418000
-- patterns[39]: 0xFAF5FAF5A050A050
-- checksum: 0x0
----- HyperTalk script -----
---------------------open stack,checks to clear report flds-------------
on OpenStack
  global totsav,nmQC,cur,f1,tst,QLvar
  put empty into QLvar
  put CleanUp into temp
  if cd fld MultCheckΓëá1 then
    if cd fld "Title" is not empty and cd fld "Totsavings" is not empty then
      answer "Some information was left in the Report field" with "Clear It" or "Leave It"
      if it= "Clear It" then
        put empty into cd fld "Title"
        put empty into cd fld "BSaved"
        put empty into cd fld "PerSaved"
        put 0 into cd fld "Totsavings"
        put 0 into totsav
      end if
      if it = "Leave It" then
        put cd fld "Totsavings" into totsav
      end if
    end if
  end if
  put 0 into cur
  set the scroll of cd fld id 4 to cur
  set the scroll of cd fld id 25 to cur
  set the scroll of cd fld id 53 to cur
  put long name of this stack into nmQC
end OpenStack
-----------------Cleans up stack before quiting-------------------------
on CloseStack
  global cur
  put CleanUp into temp
  put 0 into cur
  set the scroll of cd fld id 4 to cur
  set the scroll of cd fld id 25 to cur
  set the scroll of cd fld id 53 to cur
  set locktext of cd fld "Totsavings" to true
  set locktext of cd fld "Title" to true
  set locktext of cd fld "BSaved" to true
  put the freesize of this stack into fsQC
  if fsQC>0 then domenu "Compact Stack"
end CloseStack
-----------------------------------------------------------------------
----- This is the 'Guts' of the program...this does all the compaction
-----------------------------------------------------------------------
on DoIt
  global tst,totsav,nmQC,Numb,TotNumb,StackPath,Multcnt,ComStatus, Etst,QLtst,QLSTKName
  put empty into d
  put empty into u
  put empty into chr
  put empty into TargSTK
  ---only on Single or MultCom
  if ComStatus="S" or ComStatus="Mult"
  then
  put "Number"&&Numb&&"of"&&TotNumb into temp
  put "Attempt to compact which stack?"&&temp
  put empty into temp
  Put FileName("STAK") into TargSTK
  set cursor to watch
  if TargSTK is empty
  then
  put 1 into tst
  exit DoIt
end if
set lockscreen to true   -----these two lines will reset the screen
set lockscreen to false  -----so that the outline disappears
put short name of TargSTK into d
put "Checking stack:"&&d
put Che(TargSTK,ComStatus) into chr
if chr="S,Y" then exit Doit
if chr="M,Y,D"
then
put 1 into tst
exit Doit
end if
if chr="M,Y,C" then exit Doit
end if
if ComStatus="ENTFLDR" then  ------------only for Entire FLDR com
  put the short name of StackPath into StackName
  put "Checking stack:"&&StackName
  put Che(StackPath,ComStatus) into chr
  if chr="E,Y,C" then exit Doit ---continue with loop
  if chr="E,Y,D" then ----exit Entire Folder compact loop
    put 1 into Etst
    exit Doit
  end if
  put StackPath into TargSTK
end if
if ComStatus="Q1" then ----------------only for single QL compact
  put "Checking stack:"&&QLSTKName
  put Che(StackPath,ComStatus) into chr
  if chr="Q1,Y" then exit Doit
  put StackPath into TargSTK
end if
if ComStatus="Q2" then --------------only for entire QL compact
  put "Checking stack:"&&QLSTKName
  put Che(StackPath,ComStatus) into chr
  if chr="Q2,Y,C" then exit Doit
  if chr="Q2,Y,D" then
    put 1 into QLtst
    exit Doit
  end if
  put StackPath into TargSTK
end if
----End of Error Checking...all stacks should be compactable--------
put the size of stack TargSTK into STS
put freeSize of stack TargSTK into FTS
if FTS=0 then
  if ComStatus="Mult" then
    answer "That stack does not need to be compacted." with "Cancel Run" or "Continue Run"
    if it="Cancel Run" then
      put 1 into tst
    end if
  else
    put the short name of TargSTK into temp
    put temp&&"does not need to be compacted."
  end if
  exit Doit
end if
put the number of chars of FTS into c
put FTS into Cb
if c>3 then
  put char c-3 of Cb into temp
  put temp&"," into char c-3 of Cb
end if
set lockscreen to true
set lockmessages to true
put short name of TargSTK into d
go to TargSTK
put Userlevel into u
if u<5 then set Userlevel to 5
set cantModify of stack TargSTK to false
put "Attempting to Compact"&&Cb&&"bytes in"&&d
if StackPath is not empty then add 1 to Multcnt
domenu compact stack         ----This compacts the stack (duh!)
set lockMessages to false
show msg
go to nmQC
put "Finished compacting:"&&d
set lockscreen to false
put the number of lines in cd fld "Title" into LnsRep
add 1 to LnsRep
put Round(FTS/STS*100) into Prs
put d into line(LnsRep) of cd fld "Title"
put Cb into line(LnsRep) of cd fld "BSaved"
put Prs&&"%" into line(LnsRep) of cd fld "PerSaved"
add FTS to totsav
put totsav into cd fld "Totsavings"
end Doit
-------------------------Check the write permission--------------------
function Che TargSTK, ComStatus
global QLSTKName
put WritePermission(TargSTK,false) into WriteResult
-------Single Compaction Check---------------
if ComStatus="S" then
  if WriteResult=false then
    put the short name of TargSTK into temp
    put temp&&"can not be opened to compact."
    answer "That stack is locked or in use." with "OK"
    return "S,Y"
  else
    return "S,N"
  end if
end if
-----Multiple Compaction Check-------------
if ComStatus="Mult" then
  if WriteResult=false then
    put the short name of TargSTK into temp
    put temp&&"is locked or in use. Can not be opened to compact."
    answer "That stack is locked or in use." with "Cancel Run" or "Continue Run"
    if it="Continue Run" then return "M,Y,C"
    if it="Cancel Run" then
      return "M,Y,D"
    end if
  else
    return "M,N"
  end if
end if
-----Entire Folder Compaction Check------------------------
if ComStatus="ENTFLDR" then
  if WriteResult=false then
    put the short name of TargSTK into temp
    put temp&&"is locked. Can not be opened to compact."
    answer "That stack is locked or in use." with "Cancel Run" or "Continue Run"
    if it="Continue Run" then return "E,Y,C"
    if it="Cancel Run" then
      return "E,Y,D"
    end if
  else
    return "E,N"
  end if
end if
-----------Quick List Compaction Check (one file only)---------------
if ComStatus="Q1" then
  if WriteResult=false then
    put QLSTKName&&"can not be opened to compact."
    answer "That stack is locked or in use." with "OK"
    return "Q1,Y"
  else
    return "Q1,N"
  end if
end if
-----------Quick List Compact Entire List-------------------------
if ComStatus="Q2" then
  if WriteResult=false then
    put QLSTKName&&"could be locked or not in expected location."
    answer "That stack is locked or in use." with "Cancel Run" or "Continue Run"
    if it="Continue Run" then return "Q2,Y,C"
    if it="Cancel Run" then
      return "Q2,Y,D"
    end if
  else
    return "Q2,N"
  end if
end if
end Che